home *** CD-ROM | disk | FTP | other *** search
/ Software of the Month Club 1996 September / Software of the Month Club 1996 September.iso / mac / Software Research Institute-SRI / Business / Alpha ƒ / Tcl / SystemCode / prefs.tcl < prev    next >
Encoding:
Text File  |  1995-12-31  |  6.5 KB  |  319 lines  |  [TEXT/ALFA]
  1.  
  2.  
  3. #===============================================================================
  4.  
  5.  
  6. proc addArrDef {arr def val} {
  7.     addDef [list $arr $def] $val arr
  8. }
  9.  
  10. proc removeArrDef {arr def} {
  11.     removeDef [list $arr $def] arr
  12. }
  13.  
  14. proc addDef {def val {prefix {}}} {
  15.     global ${prefix}prefDefs
  16.     
  17.     readDefs $prefix
  18.     set ${prefix}prefDefs($def) $val
  19.     writeDefs $prefix
  20.     catch {unset ${prefix}prefDefs}
  21. }
  22.  
  23. proc removeDef {def {prefix {}}} {
  24.     global ${prefix}prefDefs
  25.     
  26.     readDefs $prefix
  27.     catch {unset ${prefix}prefDefs($def)}
  28.     writeDefs $prefix
  29.     catch {unset ${prefix}prefDefs}
  30. }
  31.  
  32. proc readDefs {{prefix {}}} {
  33.     global HOME PREFS globalPrefix
  34.  
  35.     if {![file exists "$PREFS:${prefix}defs.tcl"]} return
  36.     
  37.     set globalPrefix $prefix
  38.     uplevel #0 {source "$PREFS:${globalPrefix}defs.tcl"}
  39. }
  40.  
  41.  
  42. proc writeDefs {{prefix {}}} {
  43.     global HOME PREFS ${prefix}prefDefs 
  44.     
  45.     if {![info exists ${prefix}prefDefs]} {
  46.         catch {removeFile "$PREFS:${prefix}defs.tcl"}
  47.         return
  48.     }
  49.     
  50.     if {![file exists "$PREFS"]} {
  51.         mkdir "$PREFS"
  52.     }
  53.     set fd [open "$PREFS:${prefix}defs.tcl" "w"]
  54.     foreach nm [array names ${prefix}prefDefs] {
  55.         puts $fd [list set ${prefix}prefDefs($nm) [set ${prefix}prefDefs($nm)]]
  56.     }
  57.     close $fd
  58. }
  59.  
  60.  
  61. proc readUserDefs {} {
  62.     global prefDefs arrprefDefs PREFS
  63.     
  64.     if {[file exists "$PREFS:defs.tcl"]} {
  65.         source "$PREFS:defs.tcl"
  66.         
  67.         foreach nm [array names prefDefs] {
  68.             global $nm
  69.             set $nm $prefDefs($nm)
  70.         }
  71.         catch {unset prefDefs}
  72.     }
  73.     
  74.     if {[file exists "$PREFS:arrdefs.tcl"]} {
  75.         source "$PREFS:arrdefs.tcl"
  76.         
  77.         foreach nm [array names arrprefDefs] {
  78.             set arr [lindex $nm 0]
  79.             set field [lindex $nm 1]
  80.             set val $arrprefDefs($nm)
  81.             global $arr
  82.             set ${arr}($field) $val
  83.         }
  84.         catch {unset arrprefDefs}
  85.     }
  86.  
  87.     # Use "prefs.tcl" to define or change any tcl information. */
  88.     if {![file exists "$PREFS:prefs.tcl"]} {
  89.         
  90.         if {![file exists "$PREFS"]} {
  91.             mkdir "$PREFS"
  92.         }
  93.         set fd [open "$PREFS:prefs.tcl" "w"]
  94.         close $fd
  95.     }
  96.     uplevel #0 {
  97.         if {[catch {source "$PREFS:prefs.tcl"}]} {
  98.             alertnote "An error occurred while loading \"prefs.tcl\"" 
  99.         }
  100.     }
  101. }
  102.  
  103.     
  104. proc viewSavedSetting {} {
  105.     global prefDefs arrprefDefs
  106.  
  107.     saveModifiedVars
  108.     
  109.     readDefs
  110.     readDefs arr
  111.     
  112.     set res [listpick -p "The following settings have been saved:" [getSavedSettings]]
  113.  
  114.     if {[regexp {([^(]+)\(([^)]+)\)} $res dummy arr field]} {
  115.         set arg [list $arr $field]
  116.         set val $arrprefDefs($arg)
  117.         if {[string length $val] > 80} {
  118.             global tileLeft tileTop tileWidth
  119.             new -g $tileLeft $tileTop $tileWidth 100 -n "\$${arr}($field)"
  120.             insertText "'$res's value is:\r\r$val\r"
  121.             setWinInfo read-only 1
  122.             setWinInfo dirty 0
  123.             goto 0
  124.         } else {
  125.             alertnote "'$res's value is:\r\r$val\r"
  126.         }
  127.     } else {
  128.         global $res
  129.         alertnote "'$res's value is:\r\r$prefDefs($res)"
  130.     }
  131.  
  132.     unset prefDefs arrprefDefs
  133. }
  134.  
  135. proc removeSavedSetting {} {
  136.     global prefDefs arrprefDefs
  137.     
  138.     readDefs
  139.     readDefs arr
  140.     set res [listpick -p "Remove which setting?" [lsort -ignore [getSavedSettings]]]
  141.  
  142.     if {$res == ""} return
  143.     if {[regexp {([^(]+)\(([^)]+)\)} $res dummy arr field]} {
  144.         global $arr
  145. #         catch {unset ${arr}($field)}
  146.         removeArrDef $arr $field
  147.     } else {
  148.         global $res
  149. #         catch {unset $res}
  150.         removeDef $res
  151.     }
  152.  
  153.     unset prefDefs arrprefDefs
  154. }
  155.  
  156.  
  157. proc getSavedSettings {} {
  158.     global prefDefs arrprefDefs
  159.     
  160.     readDefs
  161.     readDefs arr
  162.     
  163.     set names [array names prefDefs]
  164.     foreach pair [array names arrprefDefs] {
  165.         lappend names "[lindex $pair 0]([lindex $pair 1])"
  166.     }
  167.     
  168.     return [lsort $names]
  169. }
  170.  
  171. #===============================================================================
  172.  
  173. proc buildRecentFiles {} {
  174.     global recentFilesSave recentFiles modifiedVars
  175.     
  176.     lappend modifiedVars
  177.     
  178.     message "Building recent files menu╔"
  179.     if {[info exists recentFiles]} {
  180.         set recentFilesSave $recentFiles
  181.     }
  182.     if {[info exists recentFilesSave]} {
  183.         foreach f $recentFilesSave {
  184.             pushRecent $f
  185.         }
  186.     }
  187.         
  188.     catch {unset recentFilesSave}
  189. }
  190.  
  191.  
  192. proc pushRecent {name} {
  193.     global recentFiles alphaLite
  194.     
  195.     if {[string match {*\**} $name] || [string match "Untit*" $name] } return
  196.     if {[info exists recentFiles] && ([set ind [lsearch -glob $recentFiles "*[file tail $name]"]] >= 0)} {
  197.         set recentFiles [lreplace $recentFiles $ind $ind]
  198.     }
  199.     lappend recentFiles $name
  200.     if {[llength $recentFiles] > 10} {
  201.         set recentFiles [lrange $recentFiles 1 end]
  202.     }
  203.     foreach f $recentFiles {
  204.         lappend tails [file tail $f]
  205.     }
  206.     if {$alphaLite} {
  207.         set name Recent
  208.     } else {
  209.         set name recent
  210.     }
  211.     menu -m -n $name -p recentProc [concat [lsort -ignore $tails] [list "(-" "Reset List"]]
  212. }
  213.  
  214. proc recentProc {menu name} {
  215.     global recentFiles
  216.     
  217.     if {$name == "Reset List"} {
  218.         unset recentFiles
  219.         menu -m -n recent -p recentProc {}
  220.     } else {
  221.         if {[set ind [lsearch $recentFiles "*:$name"]] >= 0} {
  222.             edit [lindex $recentFiles $ind]
  223.         }
  224.     }
  225. }
  226.  
  227.  
  228. proc editRecentFile {} {
  229.     global recentFiles
  230.     
  231.     foreach f $recentFiles {
  232.         lappend tails [file tail $f]
  233.     }
  234.     
  235.     foreach res [listpick -l -p {File?} [lsort -ignore $tails]]  {
  236.         set ind [lsearch $recentFiles \*:$res]
  237.         catch {edit [lindex $recentFiles $ind]}
  238.     }
  239. }
  240.  
  241.  
  242. #===============================================================================
  243.  
  244. proc editPrefs.tcl {} {
  245.     global PREFS
  246.     if {![file exists "$PREFS:prefs.tcl"]} {
  247.         set fd [open "$PREFS:prefs.tcl" "w"]
  248.         close $fd
  249.     }
  250.     edit "$PREFS:prefs.tcl"
  251. }
  252.  
  253. # Automatically add a line to the user input file
  254. proc addUserLine {line} {
  255.     global HOME PREFS
  256.  
  257.     if {![file exists "$PREFS"]} {
  258.         mkdir "$PREFS"
  259.     }
  260.     set fid [open "$PREFS:prefs.tcl" "a+"]
  261.     if {![catch {seek $fid -1 end}]} {
  262.         if {[read $fid 1] == "\r"} {
  263.             set line "\r$line"
  264.         }
  265.     }
  266.     seek $fid 0 end
  267.     puts $fid $line
  268.     close $fid
  269. }
  270.  
  271.  
  272.  
  273. #===============================================================================
  274.  
  275. proc sourceCurrentModePrefs {} { 
  276.     global mode PREFS
  277.     if {[file exists "${PREFS}:${mode}Prefs.tcl"]} {
  278.         source  "${PREFS}:${mode}Prefs.tcl"
  279.     } else {
  280.         message "Sorry, no preferences exists for '$mode' mode"
  281.     }
  282. }
  283.  
  284.  
  285. proc editCurrentModePrefs {} { 
  286.     global mode
  287.     editPrefsProc modePrefs $mode
  288. }
  289.  
  290.  
  291. proc editPrefsProc { menu m } {
  292.     message $m
  293.     global PREFS mode
  294.     # assume it is a mode, since we made the menu
  295.     
  296.     set f "$PREFS:${m}Prefs.tcl"
  297.     if [file exists $f] {
  298.         edit $f
  299.     } else {
  300.         if { [askyesno "No '$m' prefs file exists, do you want to create one?"] \
  301.             == "yes" } {
  302.             
  303.             set fd [open $f "w"]
  304.             close $fd
  305.             edit $f
  306.             insertText {## 
  307.  # This    file will be sourced automatically, immediately after 
  308.  # the _first_ time    the    file which defines its mode is sourced.
  309.  # Use this    file to    insert your    own    mode-specific preferences
  310.  # and changes,    rather than    altering the originals.
  311.  # 
  312.  # You can redefine    menus, procedures, variables,...
  313.  ##
  314.  
  315. }}}
  316.             
  317. }
  318.  
  319.